x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1, upper.y*1)
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "No. specimens", cex=1.2)
# plot time slices as shaded area
polygon (c(346.7, 330.9, 330.9, 346.7), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(323.2, 315.2, 315.2, 323.2), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(307.0, 303.7,303.7, 307.0), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 293.52, 293.52, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(290.1, 283.5, 283.5, 290.1), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(273.01, 266.9,266.9, 273.01), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(264.28, 259.51,259.51,264.28), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(254.14, 251.9,251.9, 254.14), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
#Amniotes vs. non-amniotes (change H1 (base) to H2, H3 or H4)
nbins<-nrow(bin_ranges)
bin_alphadiversity <- colSums(bin_PA)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- dat$H1_A
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-16]
bin_amniote <- colSums(bin_PA_amniote)
bin_PA_nonamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_nonamniote <- bin_PA_nonamniote[,-16]
bin_nonamniote <- colSums(bin_PA_nonamniote)
lines (midpoints, y = bin_alphadiversity, lwd=2)
textpoint <- max(bin_alphadiversity)*1.04
lines (midpoints, y = bin_amniote, lwd = 0.5)
lines (midpoints, y = bin_nonamniote, lwd = 0.5, lty = 2)
layout (matrix (1:1, 2, 1))
upper.y <- 40
lower.y <- 0
upper.CI <- results_plot[, "upper"]
lower.CI <- results_plot [, "lower"]
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1, upper.y*1)
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "No. specimens", cex=1.2)
# plot time slices as shaded area
polygon (c(346.7, 330.9, 330.9, 346.7), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(323.2, 315.2, 315.2, 323.2), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(307.0, 303.7,303.7, 307.0), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 293.52, 293.52, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(290.1, 283.5, 283.5, 290.1), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(273.01, 266.9,266.9, 273.01), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(264.28, 259.51,259.51,264.28), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(254.14, 251.9,251.9, 254.14), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
#Amniotes vs. non-amniotes (change H1 (base) to H2, H3 or H4)
nbins<-nrow(bin_ranges)
bin_alphadiversity <- colSums(bin_PA)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- dat$H2_A
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-16]
bin_amniote <- colSums(bin_PA_amniote)
bin_PA_nonamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_nonamniote <- bin_PA_nonamniote[,-16]
bin_nonamniote <- colSums(bin_PA_nonamniote)
lines (midpoints, y = bin_alphadiversity, lwd=2)
textpoint <- max(bin_alphadiversity)*1.04
lines (midpoints, y = bin_amniote, lwd = 0.5)
lines (midpoints, y = bin_nonamniote, lwd = 0.5, lty = 2)
layout (matrix (1:1, 2, 1))
upper.y <- 40
lower.y <- 0
upper.CI <- results_plot[, "upper"]
lower.CI <- results_plot [, "lower"]
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1, upper.y*1)
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "No. specimens", cex=1.2)
# plot time slices as shaded area
polygon (c(346.7, 330.9, 330.9, 346.7), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(323.2, 315.2, 315.2, 323.2), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(307.0, 303.7,303.7, 307.0), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 293.52, 293.52, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(290.1, 283.5, 283.5, 290.1), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(273.01, 266.9,266.9, 273.01), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(264.28, 259.51,259.51,264.28), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(254.14, 251.9,251.9, 254.14), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
#Amniotes vs. non-amniotes (change H1 (base) to H2, H3 or H4)
nbins<-nrow(bin_ranges)
bin_alphadiversity <- colSums(bin_PA)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- dat$H3_A
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-16]
bin_amniote <- colSums(bin_PA_amniote)
bin_PA_nonamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_nonamniote <- bin_PA_nonamniote[,-16]
bin_nonamniote <- colSums(bin_PA_nonamniote)
lines (midpoints, y = bin_alphadiversity, lwd=2)
textpoint <- max(bin_alphadiversity)*1.04
lines (midpoints, y = bin_amniote, lwd = 0.5)
lines (midpoints, y = bin_nonamniote, lwd = 0.5, lty = 2)
layout (matrix (1:1, 2, 1))
upper.y <- 40
lower.y <- 0
upper.CI <- results_plot[, "upper"]
lower.CI <- results_plot [, "lower"]
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1, upper.y*1)
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "No. specimens", cex=1.2)
# plot time slices as shaded area
polygon (c(346.7, 330.9, 330.9, 346.7), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(323.2, 315.2, 315.2, 323.2), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(307.0, 303.7,303.7, 307.0), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 293.52, 293.52, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(290.1, 283.5, 283.5, 290.1), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(273.01, 266.9,266.9, 273.01), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(264.28, 259.51,259.51,264.28), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(254.14, 251.9,251.9, 254.14), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
#Amniotes vs. non-amniotes (change H1 (base) to H2, H3 or H4)
nbins<-nrow(bin_ranges)
bin_alphadiversity <- colSums(bin_PA)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- dat$H4_A
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-16]
bin_amniote <- colSums(bin_PA_amniote)
bin_PA_nonamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_nonamniote <- bin_PA_nonamniote[,-16]
bin_nonamniote <- colSums(bin_PA_nonamniote)
lines (midpoints, y = bin_alphadiversity, lwd=2)
textpoint <- max(bin_alphadiversity)*1.04
lines (midpoints, y = bin_amniote, lwd = 0.5)
lines (midpoints, y = bin_nonamniote, lwd = 0.5, lty = 2)
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
dat$Clade <- as.factor(dat$H1_SynSaur)
pd_through_t <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(dat$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
dat_stage <- dat[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(dat_stage[,1:9],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,dat_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
dat$Clade <- as.factor(dat$H2_SynSaur)
pd_through_t <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(dat$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
dat_stage <- dat[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(dat_stage[,1:9],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,dat_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
dat$Clade <- as.factor(dat$H3_SynSaur)
pd_through_t <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(dat$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
dat_stage <- dat[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(dat_stage[,1:9],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,dat_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
dat$Clade <- as.factor(dat$H4_SynSaur)
pd_through_t <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(dat$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
dat_stage <- dat[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(dat_stage[,1:9],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,dat_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
dat$Clade <- as.factor(dat$H1_SynSaur)
pd_through_t <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(dat$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(dat$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
dat_stage <- dat[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(dat_stage[,1:9],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,dat_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
ages <- read.table("taxon_ages.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
dat$Herb <- as.factor(dat$Herb)
pd_through_t <- matrix(NA,nrow=nlevels(dat$Herb),ncol=nrow(epoch)) #Diet partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(dat$Herb),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(dat$Herb)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
dat_stage <- dat[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(dat_stage[,1:9],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,dat_stage$Herb)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('darkolivegreen','firebrick')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
